package BigIP::F5;

our $VERSION = "1.0";

=head1 NAME

BigIP::F5 - A Perl module to interface with the BigIP F5 load balancer iControl
API. Much more diverse than BigIP::iControl

Created by: Justin Hyland (jhyland87@gmail.com)

=head1 REQURES

SOAP::Lite; Switch; Data::Dumper;

=head1 SYNOPSIS

	my $connection = BigIP::F5->new('username' 	=> 'username',
					'password'	=> 'password',
					'server'	=> 'f5.domain.com',
					'port'		=> '443',
					'protocol'	=> 'https');

	BigIP::F5->setDebug(1);

	my @partitionList = BigIP::F5->listPartitions();

	BigIP::F5->setActivePartition($partitionList[0]);

	sprintf("Active Partition: %s\n", BigIP::F5->getActivePartition());

	my @poolList = BigIP::F5->listPools();
	my @poolMemberList = BigIP::F5->listPoolMembers($poolList[0]);
	my @poolsWithSpecificMember = BigIP::F5->findPoolsFromMember($poolMemberList[0]);

	BigIP::F5->setPoolMemberState("1.2.3.4:80", "STATE_ENABLED");

=head1 DESCRIPTION

This package provides an easy to use perl interface for the BigIP F5 Load
Balancer iControl API.

The F5 BigIP iControl API is an open SOAP/XML for communicating with supported
F5 BigIP products.

This package was created because there are multiple Perl modules out there, as
well as Python modules, which provide the ability to interface with the F5 API,
but they are either unstable or do not contain enough functionality to be widely
used. The python modules did things that the perl modules couldn't, and the perl
modules did things the python
modules couldn't.

=head1 Authors
Justin Hyland 
jhyland87@gmail.com
justinhyland.com
Modules: debug, set_debug, check_response, list_partitions, set_active_partition,
get_active_partition, list_pools, list_pool_members, find_pools_from_member,
set_pool_member_state

=cut

use strict;
use SOAP::Lite;
use Switch;
use UNIVERSAL 'isa';
use Data::Dumper;

$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;

our $DEBUG;
our $soap;
our $DEBUG_PREFIX = ">>";

=item new
	Module called when a new connection instance to an F5 server.
	
	EXAMPLE:
	my $connection = BigIP::F5->new('username' 	=> 'username',
					'password'	=> 'password',
					'server'	=> 'f5.domain.com',
					'port'		=> '443',
					'protocol'	=> 'https');
=cut
sub new
{
	my ($self, $settings) = (@_);

	die('Server not set for connection settings') 	if(!$settings->{'server'});
	die('Username not set for connection settings') if(!$settings->{'username'});
	die('Password not set for connection settings') if(!$settings->{'password'});
	
	$settings->{'protocol'} 	= ($settings->{'protocol'}) ? $settings->{'protocol'} : "https";
	$settings->{'port'}		= ($settings->{'port'}) ? $settings->{'port'} : "443";
	
	my $proxy_uri = sprintf("https://%s:%s@%s:443/iControl/iControlPortal.cgi", $settings->{'username'},$settings->{'password'},$settings->{'server'});
	#my $proxy_uri = sprintf("https://%s:443/iControl/iControlPortal.cgi",$settings->{'server'});

	if($DEBUG) {
		# This will print out the settings, in a pretty way
		my $dumper = Data::Dumper->new([$settings], [qw(settings)]);
		$dumper->Pad($DEBUG_PREFIX." ");
		print $dumper->Dump;
	}
	
	$self->debug("Connection URI: $proxy_uri");
	
	$soap = SOAP::Lite
		->proxy($proxy_uri);

	#sub SOAP::Transport::HTTP::Client::get_basic_credentials { 
	#	return $settings->{'username'} => $settings->{'password'};
	#}

	
	#die("SOAP FAILED!\nfaultcode: " . $soap->faultcode . "\nfaultstring: " . $soap->faultstring . "\nfaultdetail: ". $soap->faultdetail . "\n\n") if $soap->fault;
	return $soap;
}

sub new_old
{
	my ($self, $settings) = (@_);
	
	die('Server not set for connection settings') 	if(!$settings->{'server'});
	die('Username not set for connection settings') if(!$settings->{'username'});
	die('Password not set for connection settings') if(!$settings->{'password'});
	
	$settings->{'protocol'} 	= ($settings->{'protocol'}) ? $settings->{'protocol'} : "https";
	$settings->{'port'}		= ($settings->{'port'}) ? $settings->{'port'} : "443";
	
	my $proxy_uri = sprintf("%s://%s:%s/iControl/iControlPortal.cgi", $settings->{'protocol'},$settings->{'server'}, $settings->{'port'});
	
	$self->debug("Connection Settings:\n>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n". Dumper($settings)."<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<");
	$self->debug("Connection URI: $proxy_uri");
	
	
	
	sub SOAP::Transport::HTTP::Client::get_basic_credentials {
		return $settings->{'username'} => $settings->{'password'};
	}
	
	$soap = SOAP::Lite->proxy($proxy_uri);
	#print $soap->fault;
	#print Dumper($soap->faultstring);
	#die("SOAP FAILED!\nfaultcode: " . $soap->faultcode . "\nfaultstring: " . $soap->faultstring . "\nfaultdetail: ". $soap->faultdetail . "\n\n") if $soap->fault;
	
	return $soap;
}


=item divider
	Just used to divide text in a pretty format
	
	EXAMPLE
	divider("Settings");
	print "Var1: $var1; Var2: $var2\n";
	divider;
	
	OUTPUT:
	: Settings :::::::::::::::::::::::::::::::::::::::
	Var1: foo; Var2: bar
	::::::::::::::::::::::::::::::::::::::::::::::::::
=cut
sub divider {
	my $comment = shift;
	my $divider = "_";
	my $length = "50";
	my $strLen = 0;
    
	if( $comment ) {
		my @Chars = split("", $comment);
		$strLen = ++$#Chars;
		$strLen = $strLen + 3;
		my $newLength = $length - $strLen;
		print "$divider $comment " . $divider x $newLength;
	}
	else {
		print $divider x $length;
	}    
	print "\n";
}

=item set_debug
	Used to enable/disable debugging 0 = off; 1 = on
	
	EXAMPLE (Default prefix: #):
		BigIP::F5->setDebug(1);
	EXAMPLE (With custom prefix of << DEBUG >>):
		BigIP::F5->setDebug(1, "<< DEBUG >>");
=cut
sub set_debug
{
	my ($self, $level, $prefix) = (@_);
	
	our $DEBUG_PREFIX = $prefix if ($prefix);
	
	switch ($level) {
		case (0) 	{ our $DEBUG = 0; }
		case (1)	{ our $DEBUG = 1; }
		else { die ("You tried to set the debug level to '$level'... Not sure what that is") }
	}
	
	my @debug_desc = ("Debugs nothing", "Debugs everything");
	
	print "$DEBUG_PREFIX Setting debug level to $level (".$debug_desc[$DEBUG].")\n" if($DEBUG ne "0");
	
	return 0;
}

=item debug
	Outputs comtent in debug format (if debugging is enabled)
	
	EXAMPLE: BigIP::F5->debug("Debug Content");
	OUTPUT: << DEBUG >> Debug Content
=cut
sub debug 
{
	my ($self, $comment) = (@_);
	print "$DEBUG_PREFIX $comment\n" if($DEBUG ne "0");
}

=item check_response
	Checks the response of the last API call to the F5's iControl
=cut
sub check_response 
{
	my ($self, $resp) = (@_);
	
	die "$resp->faultcode $resp->faultstring\n" if $resp->fault;
	
	$self->debug("Response Check");
	
	if(ref $resp->result eq "ARRAY") {
	#if (@{$resp->result}) {
		$self->debug("Item: $_") foreach (@{$resp->result});
	}
	else {
		$self->debug("Result: ". $resp->result);
	}
}

=item list_partitions
	Lists the partitions available within the F5 interface
	
	Example: print Dumper(BigIP::F5->list_partitions);
	
	OUTPUT:
	$VAR1 = bless( {
                 'partition_name' => 'Common',
                 'description' => 'Repository for system objects and shared objects.'
               }, 'Management::Partition::AuthZPartition' );
=cut
sub list_partitions 
{
	my ($self) = (@_);
	my $soapResponse = $soap->uri("urn:iControl:Management/Partition")->get_partition_list();
	$self->check_response($soapResponse);
	my @partitions = @{$soapResponse->result};
	return @partitions;
}

=item set_active_partition
	Sets the active partition for the current setting. Only need to set this
	once per a script execution, unless you want to change the partition in
	the middle
	
	EXAMPLE: BigIP::F5->set_active_partition("Common");
=cut
sub set_active_partition
{
	my ($self,$partition) = (@_);
	my $soapResponse = $soap->uri("urn:iControl:Management/Partition")->set_active_partition
	(
		SOAP::Data->name(active_partition => $partition)
	);
	$self->check_response($soapResponse);
	
	return $?;
}

=item get_active_partition
	Returns the current partition.
	
	EXAMPLE: print "Current Partition: " . BigIP::IP->get_active_partition;
	OUTPUT: Current Partition: Common
=cut
# $server/iControl/iControlPortal.cgi?WSDL=Management.Partition
sub get_active_partition 
{
	my ($self) = (@_);
	
	my $soapResponse = $soap->uri("urn:iControl:Management/Partition")->get_active_partition();
	$self->check_response($soapResponse);
	my $partition = $soapResponse->result;
	return $partition;
}

=item list_pools
	Returns an ARRAY of pools in the current active partition
	EXAMPLE: print "POOLS: " . join(", ", BigIP::F5->list_pools) . "\n";
	OUTPUT: POOLS: pool_one, pool_two
=cut
sub list_pools
{
	my ($self) = (@_);
	
	my $soapResponse = $soap->uri("urn:iControl:LocalLB/Pool")->get_list();
	$self->check_response($soapResponse);
	
	my @pool_list = @{$soapResponse->result};
	return @pool_list;
}

=item list_pool_members
	Returns the IP and Port for the members within a specified pool.
	EXAMPLE: print Dumper(BigIP::F5->list_pool_members($pool));
	OUTPUT: $VAR1 = bless( {
                 'address' => '10.10.5.17',
                 'port' => '80'
               }, 'Common::IPPortDefinition' );
=cut
sub list_pool_members
{
	my ($self, $pool) = (@_);
	
	die("No pool set to retreve member list from") unless $pool;

	my @pools = split(' ', $pool); 	# This lets them pass multiple pools to get members from, 
					# put it in quotes, separate the pools by a space
	my $soapResponse = $soap->uri("urn:iControl:LocalLB/Pool")->get_member
	(
	SOAP::Data->name(pool_names => [@pools])
	);
	$self->check_response($soapResponse);
	
	my @member_lists = @{$soapResponse->result};
		
	return $member_lists[0][0];
}

=item find_pools_from_memnber
	Used to search through pools for a member.
	EXAMPLE: my $member = "1.2.3.4:80";
		 my @pools = BigIP::F5->find_pools_from_member($member);
		 print "$member is in pool(s): " . join(", ",@pools) . "\n";
	OUTPUT: 1.2.3.4:80 is in pool(s): pool_foo, pool_bar
=cut
sub find_pools_from_member
{
	my ($self, $node_addr_port) = (@_);
	
	my ($node_addr, $node_port) = split(/:/, $node_addr_port, 2);
	
	my @pool_match_list;
	
	my @pool_list = $self->list_pools();

	my @member_lists = $self->list_pool_members(join(" ", @pool_list));

	for my $i (0 .. $#pool_list)
	{
		my $pool = $pool_list[$i];
		foreach my $member ($member_lists[$i])
		{
			my $addr = $member->{"address"};
			my $port = $member->{"port"};

			if ( ($node_addr eq $addr) && ($node_port eq $port) )
			{
				push @pool_match_list, $pool;
			}
		}
	}
	return @pool_match_list;
}

=item set_pool_member_state
	Sets the state of a member within a pool.
	EXAMPLE: BigIP::F5->set_pool_member_state('pool_VE_agentportal', '10.10.5.17:80', 0);
	NOTE: You can use different strings to disable or enable..
		Strings that will ENABLE the pool: 1,"enable","on","STATE_ENABLED"
		And to DISABLE: 0,"disable","off","STATE_DISABLED"
=cut
sub set_pool_member_state
{
	#die("too scary to use this right now");
	
	my ($self, $pool_list, $node_addr_port, $state_str) = (@_);
	
	# Allow the state to be multiple strings.
	my @enabled = (1,"enable","on","STATE_ENABLED");
	my @disabled = (0,"disable","off","STATE_DISABLED");
	
	my $ENABLED_STATE;
	
	switch($state_str) {
		case (\@disabled) 	{ $ENABLED_STATE = "STATE_DISABLED" }
		case (\@enabled)	{ $ENABLED_STATE = "STATE_ENABLED" }
		else { die("Unable to match '$state_str' with any available states. (Can match " . join(", ", @enabled) . ", " . join(", ", @disabled) . ")"); }
	}
	
	
	my ($node_addr, $node_port) = split(/:/, $node_addr_port, 2);
	
	my @pools = split(' ', $pool_list);

	my $member = { address => $node_addr, port => $node_port };
	
	my $MemberMonitorState  = { member => $member, monitor_state => $ENABLED_STATE };
	
	my @MemberMonitorStateList;
	
	push @MemberMonitorStateList, $MemberMonitorState;
	
	my @MemberMonitorStateLists;
	
	for my $i (0 .. $#pools)
	{
		push @MemberMonitorStateLists, [@MemberMonitorStateList];
	}

	my $soapResponse = $soap->uri("urn:iControl:LocalLB/PoolMember")->set_monitor_state(
	SOAP::Data->name(pool_names => [@pools]),
	SOAP::Data->name(monitor_states => [@MemberMonitorStateLists])
	);
	
	$self->check_response($soapResponse);
}

# Annnnd were done!
return (1);

__END__

:::::: CHANGELOG ::::::
02/24/2012 - Package is created. Current modules are: debug, set_debug, check_response, list_partitions, set_active_partition, get_active_partition,
list_pools, list_pool_members, find_pools_from_member, set_pool_member_state.
By: Justin Hyland
_____________________________________________________________________________________________________________________________________________________

